ZaƂoĆŒenia projektu

Projekt zostaƂ stworzony w celu wykonania wizualizacji na podstawie danych dotyczących ruchu rowerowego w GdaƄsku. Ruch rowerowy monitorowany jest za pomocą stacji pomiarowych umiejscowionych w rĂłĆŒnych miejscach w mieƛcie. Zakres analizy obejmuje przedziaƂ czasowy od 01.10.2013 do 31.03.2021 roku. Projekt zakƂada stworzenie wizualizacji na podstawie dziewięciu poleceƄ. Do pierwszych dwĂłch poleceƄ zostaną wykorzystane wykresy z R Graphics, natomiast pozostaƂe polecenia zostaną wykonane przy pomocy pakietu ggplot2 oraz jego rozszerzeƄ.


Utworzenie i modyfikacja zmiennych

ZostaƂy utworzone zmienne takie jak: Month, Year, Day, Dzie_tyg, Czy_Weekend oraz Pora_Roku na podstawie zmiennej Data, a takĆŒe zostaƂ zmieniony typ nowych zmiennych na factor.

przejazdy$Month <- month(ymd(przejazdy$Data)) 
przejazdy$Year <- year(ymd(przejazdy$Data))
przejazdy$Day <- day(ymd(przejazdy$Data))
przejazdy$Dzien_tyg <- as.character(przejazdy$Data, format = "%A")
przejazdy$Czy_Weekend <- ifelse(przejazdy$Dzien_tyg %in% c("sobota", "niedziela"),"weekend", "dzieƄ powszedni")

przejazdy <- przejazdy %>%
  mutate(Month = factor(Month), Year = factor(Year), Day = factor(Day), 
         Dzien_tyg = factor(Dzien_tyg), Czy_Weekend = factor(Czy_Weekend))

przejazdy$Pora_Roku <- ifelse(przejazdy$Month %in% c("12", '1', '2'), 'Zima', 
                              ifelse(przejazdy$Month %in% c("3", '4', '5'), 'Wiosna',
                              ifelse(przejazdy$Month %in% c("6", '7', '8'), 'Lato', 'JesieƄ')))

przejazdy$Pora_Roku <- as.factor(przejazdy$Pora_Roku)

levels(przejazdy$Month) <- c('1' = 'StyczeƄ', '2' = 'Luty', '3' = 'Marzec',
                              '4' = 'KwiecieƄ', '5' = 'Maj', '6' = 'Czerwiec',
                              '7' = 'Lipiec', '8' = 'SierpieƄ', '9' = 'WrzesieƄ',
                              '10' = 'PaĆșdziernik', '11' = 'Listopad', '12' = 'GrudzieƄ')

punkty <- rename(punkty, Stacja = stacja)

Polecenie 1.

Przedstawić rozkƂad liczby dni pomiarowych w poszeczególnych punktach.

zad1 <- przejazdy[,c(1,3)]

zad1 <- zad1 %>%
  group_by(Stacja) %>%
  summarise(Liczba_dni = n()) %>%
  arrange(desc(Liczba_dni))


par(mar=c(5, 11, 4, 2))
barplot(sort(zad1$Liczba_dni),
        names.arg = zad1$Stacja[order(zad1$Liczba_dni)],
        main = "RozkƂad liczby dni wedƂug punktu pomiarowego",
        xlab = "Liczba dni",
        space = 0.3,
        col = rev(viridis(35)),
        horiz=T,
        cex.names=0.8,
        las=1,
        font.axis = 3,
        font.lab = 2)


Polecenie 2.

Dla wybranego punktu przedstawić rozkƂad liczby przejazdów.

zad2 <- przejazdy[,c(1,2,3)]

zad2 <- zad2 %>%
  filter(Stacja == "Pas Nadmorski")

par(mar=c(5, 5, 4, 2))
hist(zad2$Licznik,
     main="RozkƂad liczby przejazdów w punkcie pomiarowym Pas Nadmorski",
     xlab="Liczba przejazdĂłw",
     ylab = "Częstoƛć",
     col="darkorange1",
     border = "black",
     breaks = seq(0,12000,500),
     xlim = c(0,12500),
     las = 1,
     font.axis = 3,
     font.lab = 2)


Polecenie 3.

PorĂłwnać punkty pod względem natÄ™ĆŒenia / rozkƂadu przejazdĂłw.

PorĂłwnanie względen natÄ™ĆŒenia

zad3 <- przejazdy %>%
  group_by(Stacja) %>%
  summarise(Liczba_dni = n(), 
            Suma_przejazdow = sum(Licznik), 
            Natezenie = round(Suma_przejazdow / Liczba_dni,1)) %>%
  arrange(desc(Natezenie))
  
zad3
## # A tibble: 27 x 4
##    Stacja                     Liczba_dni Suma_przejazdow Natezenie
##    <fct>                           <int>           <dbl>     <dbl>
##  1 Pas Nadmorski                    2678        6765929      2526.
##  2 al. Zwycięstwa                   2739        6249800      2282.
##  3 ul. 3 Maja                       2647        4102298      1550.
##  4 al. Grunwaldzka (Wrzeszcz)       2678        3861112      1442.
##  5 ul. Kartuska                     1582        1899110.     1200.
##  6 al. Grunwaldzka (UG)             2313        2636624      1140.
##  7 ul. ChƂopska                     1613        1824906      1131.
##  8 BƂędnik                          2037        2250485      1105.
##  9 al. Hallera                      1978        2176510      1100.
## 10 al. Rzeczpospolitej              1613        1477426       916.
## # ... with 17 more rows
ggplot(zad3, aes(x = reorder(Stacja, -Natezenie), y = Natezenie)) + geom_bar(stat="identity", fill = heat.colors(27), alpha = 0.8) +
  theme(axis.text.x = element_text(angle = 45, hjust = 1),
        axis.title.x = element_text(color="Grey40", size=16),
        axis.title.y = element_text(color="Grey40", size=16),                            
        legend.position = "none",
        plot.title = element_text(color="grey40", face = "bold", size=19, family="serif")) +
  scale_y_continuous(breaks = seq(0, 3000, 500)) +
  annotate(geom = 'rect',
           xmin = 0.5, xmax = 3.5,
           ymin = 0.5, ymax = 2600,
           fill = 'green',
           alpha = 0.4) +
  annotate("text", x = 7.5, y = 2400, label = "Stacje o największym natÄ™ĆŒeniu") +
  annotate(geom = 'rect',
           xmin = 24.5, xmax = 27.5,
           ymin = 0.5, ymax = 400,
           fill = 'pink',
           alpha = 0.6) +
  annotate("text", x = 23.5, y = 500, label = "Stacje o najniĆŒszym natÄ™ĆŒeniu") +
  xlab("Stacja") +
  ylab("NatÄ™ĆŒenie") +
  ggtitle('NatÄ™ĆŒenie ruchu rowerowego w zaleĆŒnoƛci od stacji')

Porównanie względem rozkƂadu dla wybranych stacji

zad3.1 <- przejazdy %>%
  filter(Stacja == "Pas Nadmorski" | Stacja == "ul. Kartuska" | Stacja == "al. Hallera" |
         Stacja == "ul. Jaƛkowa Dolina" | Stacja == "ul. Wita Stwosza" | Stacja == "ul. Sucharskiego" |
         Stacja == "al. Havla" | Stacja == "al. Ć»oƂnierzy Wyklętych" | Stacja == "ul. 3 Maja")

Za pomocą histogramu

ggplot(zad3.1, aes(x = Licznik, fill = Stacja)) + geom_histogram(binwidth = 600, show.legend = F, alpha = 0.8) + 
  facet_wrap(~Stacja) +
  scale_x_continuous(breaks = seq(0, 12000, 1500)) +  
  xlab("Liczba przejazdĂłw") +
  ylab("Liczebnoƛć") +
  ggtitle('RozkƂady liczby przejazdów dla wybranych stacji') +
  theme(axis.text.x = element_text(angle = 45, hjust = 1),
        axis.title.x = element_text(color="Grey40", size=16),
        axis.title.y = element_text(color="Grey40", size=16),                            
        legend.position = "none",
        strip.background = element_rect(colour = "black", fill = "white"),
        strip.text = element_text(face = "italic", size = 12),
        plot.title = element_text(color="grey40", size=19, family="serif", face = "bold"))

Za pomocą wykresu z pakietu ggridges

ggplot(zad3.1, aes(x = Licznik, y = Stacja, fill = Stacja)) +
  geom_density_ridges(scale = 2, show.legend = F) +  
  theme_ridges()

Za pomocą wykresu skrzynkowego

ggplot(zad3.1, aes(x = Stacja, y = Licznik, fill = Stacja)) + geom_boxplot(show.legend = F) +
  xlab("Stacja") + ylab("Licznik") + ggtitle("RozkƂad liczby przejazdów względem wybranej stacji") +
  theme_minimal() +
  theme(axis.text.x = element_text(angle = 45, hjust = 1),
        axis.title.x = element_text(color="Grey40", size=16),
        axis.title.y = element_text(color="Grey40", size=16),                            
        legend.position = "none",
        plot.title = element_text(color="grey40", face = "bold", size=19, family="serif"))


Polecenie 4.

Przedstawić natÄ™ĆŒenie / rozkƂad przejazdĂłw dla wybranej stacji (Pas Nadmorski) w zaleĆŒnoƛci od miesiąca / dnia tygodnia / dni powszednich / weekendowych.

NatÄ™ĆŒenie a miesiąc

zad4 <- przejazdy %>%
  filter(Stacja == "Pas Nadmorski") %>%
  group_by(Month) %>%
  summarise(Liczba_dni = n(), 
            Suma_przejazdow = sum(Licznik), 
            Natezenie = round(Suma_przejazdow / Liczba_dni,1))


ggplot(zad4, aes(x = reorder(Month, -Natezenie), y = Natezenie)) + geom_bar(stat="identity", fill = 'slateblue', alpha = 0.8) +
  theme(axis.text.x = element_text(angle = 45, hjust = 1),
    axis.title.x = element_text(color="Grey40", size=16),
        axis.title.y = element_text(color="Grey40", size=16),                            
        legend.position = "none",
        plot.title = element_text(color="grey40", face = "bold", size=19, family="serif")) +
  scale_y_continuous(breaks = seq(0, 6000, 500)) +
  annotate(geom = 'rect',
           xmin = 0.5, xmax = 3.5,
           ymin = 0.5, ymax = 5900,
           fill = 'green',
           alpha = 0.4) +
  annotate("text", x = 5.5, y = 5400, label = "Miesiące o największym natÄ™ĆŒeniu") +
  annotate(geom = 'rect',
           xmin = 9.5, xmax = 12.5,
           ymin = 0.5, ymax = 800,
           fill = 'pink',
           alpha = 0.6) +
  annotate("text", x = 10.5, y = 1150, label = "Miesiące o najniĆŒszym natÄ™ĆŒeniu") +
  xlab("Miesiąc") +
  ylab("NatÄ™ĆŒenie") +
  ggtitle('NatÄ™ĆŒenie ruchu rowerowego w zaleĆŒnoƛci od miesiąca')

NatÄ™ĆŒenie a typ dnia i pora roku

zad4.1 <- przejazdy %>%
  filter(Stacja == "Pas Nadmorski") %>%
  group_by(Czy_Weekend, Pora_Roku) %>%
  summarise(Liczba_dni = n(), 
            Suma_przejazdow = sum(Licznik), 
            Natezenie = round(Suma_przejazdow / Liczba_dni,1))

ggplot(zad4.1, aes(x = Czy_Weekend, y = Natezenie, fill = Czy_Weekend)) + geom_col(alpha = 0.8) +
  geom_label(aes(x = Czy_Weekend, y = Natezenie, label = Natezenie)) +
  scale_fill_manual(values = c('orangered3', 'royalblue2')) +
  theme_bw() + 
  theme(axis.title.x=element_blank(),
        axis.title.y = element_text(color="Grey40", size=16),
        strip.background = element_rect(colour = "black", fill = 'lightyellow2'),
        strip.text = element_text(face = "italic", size = 10),
        legend.position = "none",
        plot.title = element_text(color="grey40", face = "bold", size=19, family="serif")) +
  scale_y_continuous(breaks = seq(0, 8000, 1000)) + facet_wrap(~Pora_Roku)

RozkƂad a miesiąc

zad4.2 <- przejazdy %>%
  filter(Stacja == "Pas Nadmorski")

ggplot(zad4.2, aes(x = Licznik, fill = Month)) + geom_histogram(binwidth = 800, show.legend = F, alpha = 0.8) + 
  facet_wrap(~Month) +
  scale_x_continuous(breaks = seq(0, 12000, 2000)) +  
  xlab("Liczba przejazdĂłw") +
  ylab("Liczebnoƛć") +
  theme_bw() +
  ggtitle('RozkƂady liczby przejazdĂłw w zaleĆŒnoƛci od miesiąca') +
  theme(axis.text.x = element_text(angle = 45, hjust = 1),
        axis.title.x = element_text(color="Grey40", size=16),
        axis.title.y = element_text(color="Grey40", size=16),                            
        legend.position = "none",
        strip.background = element_rect(colour = "black", fill = "white"),
        strip.text = element_text(face = "italic", size = 9),
        plot.title = element_text(color="grey40", size=19, family="serif", face = "bold"))

RozkƂad a dzieƄ tygodnia

ggplot(zad4.2, aes(x = Licznik, fill = Dzien_tyg)) + geom_histogram(binwidth = 800, show.legend = F, alpha = 0.8) + 
  facet_wrap(~Dzien_tyg) +
  scale_x_continuous(breaks = seq(0, 12000, 2000)) +  
  xlab("Liczba przejazdĂłw") +
  ylab("Liczebnoƛć") +
  ggtitle('RozkƂady liczby przejazdĂłw w zaleĆŒnoƛci od dnia tygodnia') +
  theme_bw() +
  theme(axis.text.x = element_text(angle = 45, hjust = 1),
        axis.title.x = element_text(color="Grey40", size=16),
        axis.title.y = element_text(color="Grey40", size=16),                            
        legend.position = "none",
        strip.background = element_rect(colour = "black", fill = "white"),
        strip.text = element_text(face = "italic", size = 9),
        plot.title = element_text(color="grey40", size=19, family="serif", face = "bold"))

RozkƂad a weekend

histweek <- ggplot(zad4.2, aes(x = Licznik, fill = Czy_Weekend)) + geom_histogram(binwidth = 800, show.legend = F, alpha = 0.8) + 
  facet_wrap(~Czy_Weekend) +
  scale_x_continuous(breaks = seq(0, 12000, 2000)) +  
  xlab("Liczba przejazdĂłw") +
  ylab("Liczebnoƛć") +
  ggtitle('Jako histogram') +
  theme_bw() +
  theme(axis.text.x = element_text(angle = 45, hjust = 1),
        axis.title.x = element_text(color="Grey40", size=16),
        axis.title.y = element_text(color="Grey40", size=16),                            
        legend.position = "none",
        strip.background = element_rect(colour = "black", fill = "white"),
        strip.text = element_text(face = "italic", size = 9),
        plot.title = element_text(color="grey40", size=19, family="serif", face = "bold"))

boxweek <- ggplot(zad4.2, aes(y = Licznik, fill = Czy_Weekend)) + geom_boxplot(show.legend = F, alpha = 0.8) + 
  facet_wrap(~Czy_Weekend) +
  scale_y_continuous(breaks = seq(0, 12000, 2000)) +
  ylab("Liczba przejazdĂłw") +
  ggtitle('Jako wykres skrzynkowy') +
  theme_bw() +
  theme(axis.title.x = element_text(color="Grey40", size=16),
        axis.title.y = element_text(color="Grey40", size=16),
        axis.text.x=element_blank(),
        legend.position = "none",
        strip.background = element_rect(colour = "black", fill = "white"),
        strip.text = element_text(face = "italic", size = 9),
        plot.title = element_text(color="grey40", size=19, family="serif", face = "bold"))

grid.arrange(boxweek, histweek)

RozkƂad a pora roku

ggplot(zad4.2, aes(x = Licznik, fill = Pora_Roku)) + geom_histogram(binwidth = 800, show.legend = F, alpha = 0.8) + 
  facet_wrap(~Pora_Roku) +
  scale_x_continuous(breaks = seq(0, 12000, 2000)) +  
  xlab("Liczba przejazdĂłw") +
  ylab("Liczebnoƛć") +
  ggtitle('RozkƂady liczby przejazdĂłw w zaleĆŒnoƛci od pory roku') +
  scale_fill_manual(values = c('sandybrown', 'firebrick3', 'palegreen3', 'lavender')) +
  theme_bw() +
  theme(axis.text.x = element_text(angle = 45, hjust = 1),
        axis.title.x = element_text(color="Grey40", size=16),
        axis.title.y = element_text(color="Grey40", size=16),                            
        legend.position = "none",
        strip.background = element_rect(colour = "black", fill = "white"),
        strip.text = element_text(face = "italic", size = 9),
        plot.title = element_text(color="grey40", size=19, family="serif", face = "bold"))


Polecenie 5.

PorĂłwnać stacje pod względem zaleĆŒnoƛci z poprzedniego punktu.

Porównanie wszystkich stacji na podstawie ƛredniej liczby przejazdów

ggplot(data = przejazdy) +
  geom_line(stat = "summary",
            fun = mean,
            mapping =aes(x = Month, 
                         y = Licznik,
                         group = Dzien_tyg,
                         color = Dzien_tyg,
                         linetype = Czy_Weekend)) + 
  facet_wrap(facets = vars(Stacja),
             scales = "free_y") +
  theme_minimal() + 
  theme(axis.text.x = element_text(angle = 70, hjust = 1),
        axis.title.x = element_text(color="Grey40", size=16),
        axis.title.y = element_text(color="Grey40", size=16),
        legend.title = element_text(size=10.5),
        legend.text = element_text(size=8.5),
        legend.position = "right",
        legend.justification = c(0.94,0.94),
        legend.background = element_rect(fill="grey88",
                                         size=0.5, linetype="solid", 
                                         colour ="darkslateblue"),
        strip.background = element_rect(colour = "black", fill = "white"),
        strip.text = element_text(face = "italic", size = 9),
        plot.title = element_text(color="grey40", size=19, family="serif", face = "bold")) +
  ylab("Licznik") + xlab("Miesiąc") +
  ggtitle('PorĂłwnanie stacji w zaleĆŒnoƛci od ƛredniej liczby przejazdĂłw')

PorĂłwnanie wybranych stacji

zad5 <- przejazdy %>%
  filter(Stacja == "Pas Nadmorski" | Stacja == 'al. Grunwaldzka (UG)' |  
           Stacja == "al. Hallera" | Stacja == "ul. Jaƛkowa Dolina")

ggplot(zad5, aes(x = Pora_Roku, y = Licznik, fill=Pora_Roku)) + geom_boxplot(size=1.2, alpha=0.5) + facet_grid(~Stacja) +
  theme_bw() + ylab("Licznik") + 
  ggtitle("Wybrane stacje ze względu na porę roku") +
  scale_fill_manual(values = c('sandybrown', 'firebrick3', 'palegreen3', 'lavender')) +
  theme(axis.title.y = element_text(color="Grey23", size=16),
        axis.text.y = element_text(size=10),
        axis.title.x=element_blank(),
        legend.title = element_text(size=12),
        legend.text = element_text(size=8),
        legend.position = "none",
        plot.title = element_text(color="grey30", size=22, family="serif"))

ggplot(zad5, aes(x = Czy_Weekend, y = Licznik, fill=Czy_Weekend)) + geom_boxplot(size=1.2, alpha=0.5) + facet_grid(~Stacja) +
  theme_bw() + ylab("Licznik") + 
  ggtitle("Wybrane stacje ze względu na dzieƄ tygodnia") +
  theme(axis.title.y = element_text(color="Grey23", size=16),
        axis.text.y = element_text(size=10),
        axis.title.x=element_blank(),
        legend.title = element_text(size=12),
        legend.text = element_text(size=8),
        legend.position = "none",
        plot.title = element_text(color="grey30", size=22, family="serif"))


Polecenie 6.

Dla wybranej stacji (Pas Nadmorski) przedstawić zaleĆŒnoƛć między liczbą przejazdĂłw a wybranymi warunkami pogodowymi.

zad6 <- przejazdy %>%
  filter(Stacja == "Pas Nadmorski")

ggplot(zad6, aes(x = Temperatura, y = Licznik, color = Pora_Roku, shape = Czy_Weekend)) + geom_point(size = 3, alpha=0.7) +
  theme_minimal() +
  scale_color_manual(values = c('sandybrown', 'firebrick3', 'palegreen3', 'lavender')) +
  ggtitle("ZaleĆŒnoƛć liczby przejazdĂłw i temperatury") + xlab("Temperatura [C]") + ylab("Liczba przejazdĂłw") +
  theme(axis.title.y = element_text(color="Grey23", size=15),
        axis.text.y = element_text(size=12),
        axis.title.x = element_text(color="Grey23", size=15),
        axis.text.x = element_text(size=12),
        legend.title = element_text(size=12),
        legend.text = element_text(size=10),
        legend.position = "right",
        legend.justification = c(0.94,0.94),
        legend.background = element_rect(fill="grey88",
                                         size=0.5, linetype="solid", 
                                         colour ="grey40"),
        plot.title = element_text(color="grey40", size=25, family="serif"))

ggplot(zad6, aes(x = Wilgotnoƛć, y = Licznik, color = Pora_Roku, shape = Czy_Weekend)) + geom_point(size = 3, alpha=0.7) +
  theme_minimal() +
  scale_color_manual(values = c('sandybrown', 'firebrick3', 'palegreen3', 'lavender')) +
  ggtitle("ZaleĆŒnoƛć liczby przejazdĂłw i wilgotnoƛci") + xlab("Wilgotnoƛć [%]") + ylab("Liczba przejazdĂłw") +
  theme(axis.title.y = element_text(color="Grey23", size=15),
        axis.text.y = element_text(size=12),
        axis.title.x = element_text(color="Grey23", size=15),
        axis.text.x = element_text(size=12),
        legend.position = "none",
        plot.title = element_text(color="grey40", size=25, family="serif"))

ggplot(zad6, aes(x = Ciƛnienie_stacja, y = Licznik, color = Pora_Roku, shape = Czy_Weekend)) + geom_point(size = 3, alpha=0.7) +
  theme_minimal() +
  scale_color_manual(values = c('sandybrown', 'firebrick3', 'palegreen3', 'lavender')) +
  ggtitle("ZaleĆŒnoƛć liczby przejazdĂłw i ciƛnienia powietrza") + xlab("Ciƛnienie powietrza [hPa]") + ylab("Liczba przejazdĂłw") +
  theme(axis.title.y = element_text(color="Grey23", size=15),
        axis.text.y = element_text(size=12),
        axis.title.x = element_text(color="Grey23", size=15),
        axis.text.x = element_text(size=12),
        legend.position = "none",
        plot.title = element_text(color="grey40", size=25, family="serif"))

ggplot(zad6, aes(x = Zachmurzenie, y = Licznik, color = Pora_Roku, shape = Czy_Weekend)) + geom_point(size = 3, alpha=0.7) +
  theme_minimal() +
  scale_color_manual(values = c('sandybrown', 'firebrick3', 'palegreen3', 'lavender')) +
  ggtitle("ZaleĆŒnoƛć liczby przejazdĂłw i zachmurzenia") + xlab("Zachmurzenie [oktanty]") + ylab("Liczba przejazdĂłw") +
  theme(axis.title.y = element_text(color="Grey23", size=15),
        axis.text.y = element_text(size=12),
        axis.title.x = element_text(color="Grey23", size=15),
        axis.text.x = element_text(size=12),
        legend.position = "none",
        plot.title = element_text(color="grey40", size=25, family="serif"))

ggplot(zad6, aes(x = Wiatr, y = Licznik, color = Pora_Roku, shape = Czy_Weekend)) + geom_point(size = 3, alpha=0.7) +
  theme_minimal() +
  scale_color_manual(values = c('sandybrown', 'firebrick3', 'palegreen3', 'lavender')) +
  ggtitle("ZaleĆŒnoƛć liczby przejazdĂłw i siƂy wiatru") + xlab("Wiatr [m/s]") + ylab("Liczba przejazdĂłw") +
  theme(axis.title.y = element_text(color="Grey23", size=15),
        axis.text.y = element_text(size=12),
        axis.title.x = element_text(color="Grey23", size=15),
        axis.text.x = element_text(size=12),
        legend.position = "none",
        plot.title = element_text(color="grey40", size=25, family="serif"))


Polecenie 7.

PorĂłwnać stacje (wybrane) pod względem zaleĆŒnoƛci z poprzedniego punktu.

W tym celu zostaƂa stworzona animacja za pomocą pakietu gganimate.

zad7 <- przejazdy %>%
  filter(Stacja == "Pas Nadmorski" | Stacja == "ul. Kartuska" | Stacja == "al. Hallera" |
           Stacja == "ul. Jaƛkowa Dolina" | Stacja == "ul. Wita Stwosza" | Stacja == "ul. Sucharskiego")

chartZad7 <- ggplot(zad7, aes(x = Temperatura, y = Licznik, color = Stacja, size = Wiatr)) + 
  geom_point(alpha = 0.7, stroke = 1) + 
  theme_minimal() +
  labs(title = "ZaleĆŒnoƛć temperatury od liczby przejazdĂłw w czasie",
       x = "Temperatura [C]",
       y = "Liczba przejazdĂłw") +
  theme(axis.title.x = element_text(color="Grey40", size=16),
        axis.title.y = element_text(color="Grey40", size=16),
        legend.title = element_text(size=10.5),
        legend.text = element_text(size=8.5),
        legend.position = "right",
        legend.justification = c(0.94,0.94),
        legend.background = element_rect(fill="grey98",
                                         size=0.5, linetype="solid", 
                                         colour ="grey50"),
        strip.background = element_rect(colour = "black", fill = "white"),
        strip.text = element_text(face = "italic", size = 9),
        plot.title = element_text(color="grey40", size=19, family="serif", face = "bold")) +
  scale_color_brewer(palette = 'Set2')

mojaAnimacja <- chartZad7 +
  transition_time(Data) +
  labs(subtitle = "DzieƄ: {frame_time}") +
  shadow_wake(wake_length = 0.1)

animate(mojaAnimacja, height = 750, width = 900, nframes= 150, fps = 15, duration = 40, end_pause = 30, res = 100)

anim_save("mojaAnimacja.gif")

Polecenie 8.

Nanieƛć na mapę wybrane statystyki dotyczące przejazdów w punktach pomiarowych

statystyki <- przejazdy %>%
  group_by(Stacja) %>%
  summarise("Srednia" = mean(Licznik),
            "Odchylenie standardowe" = sd(Licznik),
            "Minimum" = min(Licznik),
            "Kwartyl 1" = quantile(Licznik, 0.25),
            "Mediana" = median(Licznik),
            "Kwartyl 3" = quantile(Licznik, 0.75),
            "Maksimum" = max(Licznik))

statystyki %>%
  kbl(caption = "Podstawowe statystyki dla stacji pomiarowych") %>%
  kable_styling(bootstrap_options = c("hover", "condensed")) %>%
  kable_paper()
Podstawowe statystyki dla stacji pomiarowych
Stacja Srednia Odchylenie standardowe Minimum Kwartyl 1 Mediana Kwartyl 3 Maksimum
Pas Nadmorski 2526.4858 2348.6505 42.0000 624.25 1556.5 4147.75 11493
al. Zwycięstwa 2281.7817 1684.0541 32.0000 802.00 1821.0 3689.50 6968
ul. 3 Maja 1549.7915 1040.0276 0.0000 609.00 1339.0 2430.00 4489
al. Grunwaldzka (Wrzeszcz) 1441.7894 1008.9708 30.0000 560.00 1214.0 2207.75 4428
BƂędnik 1104.8036 846.2111 23.0000 374.00 803.0 1819.00 3257
al. Hallera 1100.3589 881.1915 17.0000 353.25 756.0 1807.25 3969
ul. ChƂopska 1131.3738 775.3459 23.0000 454.00 877.0 1792.00 3097
al. Grunwaldzka (UG) 1139.9153 803.1204 23.0000 447.00 936.0 1719.00 3777
ul. Kartuska 1200.4487 915.1864 22.7269 393.25 924.0 1937.25 3806
KanaƂ Raduni 845.3109 680.3250 10.0000 268.25 607.0 1369.00 2747
al. Rzeczpospolitej 915.9492 673.8896 9.0000 330.00 700.0 1485.00 2728
ul. KoƂobrzeska 417.4041 316.3826 2.0000 153.00 299.0 677.00 1271
al. Havla 556.0905 468.3807 0.0000 152.00 386.5 933.50 2078
ul. Ɓostowicka 518.7133 398.4997 10.0000 169.00 400.0 837.75 1601
ul. Jaƛkowa Dolina 456.5970 343.1822 19.0000 153.00 355.0 726.00 1468
ul. Nowolipie 426.3689 330.8752 6.0000 140.00 318.0 700.00 1468
ul. Kliniczna 395.0942 300.0793 0.0000 133.00 297.0 651.00 1632
ul. Wyzwolenia 359.8239 302.2553 0.0000 108.00 221.0 621.00 1733
ul. RybiƄskiego 372.7545 289.8148 0.0000 134.00 269.0 603.00 1425
al. ƻoƂnierzy Wyklętych 351.3504 255.8096 7.0000 126.00 272.0 568.00 1058
ul. Stryjewskiego 314.1943 258.3993 0.0000 93.00 215.0 525.00 1148
ul. Wita Stwosza 289.7849 209.5101 0.0000 107.75 245.0 447.00 1001
al. Jana PawƂa II 296.4346 235.1679 0.0000 96.00 219.0 470.00 1050
ul. Sucharskiego 176.6255 157.5612 0.0000 51.00 109.0 288.00 838
ul. Elbląska 175.3428 137.3663 0.0000 58.00 122.0 295.00 619
Karczemki 345.9585 270.3222 10.0000 111.00 257.0 555.00 1213
ul. SƂowackiego (Matarnia) 220.8628 171.5084 6.0000 74.00 162.0 356.00 724
punkty <- left_join(x = punkty,
                    y = statystyki,
                    by = "Stacja")

Stacja a ƛrednia liczba przejazdów

tmap_mode("view")
tm_shape(punkty) +
  tm_symbols(size = "Srednia", 
             scale = 6,
             col = "royalblue3",
             alpha = 0.7) +
  tm_basemap(providers$OpenStreetMap)

Stacja a mediana liczby przejazdĂłw

tmap_mode("view")
tm_shape(punkty) +
  tm_symbols(size = "Mediana", 
             scale = 6,
             col = "salmon3",
             alpha = 0.7) +
  tm_basemap(providers$OpenStreetMap)

Stacja a maksymalna liczba przejazdĂłw

tmap_mode("view")
tm_shape(punkty) +
  tm_symbols(size = "Maksimum", 
             scale = 6,
             col = "darkorchid2",
             alpha = 0.7) +
  tm_basemap(providers$OpenStreetMap)

Polecenie 9.

Przedstawić zaleĆŒnoƛci między zmiennymi opisującymi warunki pogodowe.

Za pomocą ggcorrplot() oraz geom_hex()

zad9 <- przejazdy[, c(4:12)]
pogodaKor <- round(cor(zad9),2)
ggcorrplot(pogodaKor, hc.order = TRUE, type = "lower",
           outline.col = "white", colors = c('coral2', 'azure1', 'palegreen2'), lab = T)

ggplot(zad9, aes(x = Zachmurzenie, y = Wilgotnoƛć)) + geom_hex(bins = 60) + 
  scale_fill_gradient(low = "lightsteelblue1", high = "springgreen3") +
  theme_minimal() + 
  ylab("Zachmurzenie [oktany]") + ylab("Wilgotnoƛć [%]") +
  ggtitle('ZaleĆŒnoƛć pomiędzy wilgotnoƛcią i zachmurzeniem') + 
  theme(axis.title.x = element_text(color="Grey40", size=16),
        axis.title.y = element_text(color="Grey40", size=16),
        plot.title = element_text(color="grey40", size=19, family="serif", face = "bold"))

ggplot(zad9, aes(x = Ciƛnienie_stacja, y = Ciƛnienie_morze)) + geom_hex(bins = 80) + 
  scale_fill_gradient(low = "khaki3", high = "darkorchid2") + 
  theme_minimal() + 
  ylab("Ciƛnienie morza [hPa]") + xlab("Ciƛnienie powietrza [hPa]") +
  ggtitle('ZaleĆŒnoƛć pomiędzy ciƛnienem morza i powietrza') +
  theme(axis.title.x = element_text(color="Grey40", size=16),
        axis.title.y = element_text(color="Grey40", size=16),
        plot.title = element_text(color="grey40", size=19, family="serif", face = "bold"))

ggplot(zad9, aes(x = Temperatura, y = Wilgotnoƛć)) + geom_hex(bins = 70) + 
  scale_fill_gradient(low = "deepskyblue2", high = "firebrick3") +
  theme_minimal() + 
  ylab("Wilgotnoƛć [%]") + xlab("Temperatura [C]") +
  ggtitle('ZaleĆŒnoƛć pomiędzy wilgotnoƛcią i temperaturą') +
  theme(axis.title.x = element_text(color="Grey40", size=16),
        axis.title.y = element_text(color="Grey40", size=16),
        plot.title = element_text(color="grey40", size=19, family="serif", face = "bold"))

ggplot(zad9, aes(x = Temperatura, y = Ciƛnienie_woda)) + geom_hex(bins = 70)  + 
  scale_fill_gradient(low = "cadetblue2", high = "goldenrod3") +
  theme_minimal() + 
  ylab("Ciƛnienie wody [hPa]") + xlab("Temperatura [C]") +
  ggtitle('ZaleĆŒnoƛć pomiędzy ciƛnienem wody i temperaturą') +
  theme(axis.title.x = element_text(color="Grey40", size=16),
        axis.title.y = element_text(color="Grey40", size=16),
        plot.title = element_text(color="grey40", size=19, family="serif", face = "bold"))

ggplot(zad9, aes(x = Wilgotnoƛć, y = Opady_dzieƄ)) + geom_hex(bins = 70)  + 
  scale_fill_gradient(low = "lightblue3", high = "deeppink3") +
  theme_minimal() + 
  ylab("Suma opadów w ciągu dnia [mm]") + xlab("Wilgotnoƛć [%]") +
  ggtitle('ZaleĆŒnoƛć pomiędzy sumą opadĂłw w ciągu dnia i wilgotnoƛcią') +
  theme(axis.title.x = element_text(color="Grey40", size=16),
        axis.title.y = element_text(color="Grey40", size=16),
        plot.title = element_text(color="grey40", size=19, family="serif", face = "bold"))

Za pomocą wykresów skrzynkowych

ggplot(przejazdy, aes(x = Month, y = Temperatura, fill = Month)) + geom_boxplot(alpha = 0.8) + theme_bw() +
  theme(axis.text.x = element_text(angle = 45, hjust = 1),
        axis.title.x = element_text(color="Grey40", size=16),
        axis.title.y = element_text(color="Grey40", size=16),                            
        legend.position = "none",
        strip.background = element_rect(colour = "black", fill = "white"),
        strip.text = element_text(face = "italic", size = 9),
        plot.title = element_text(color="grey40", size=19, family="serif", face = "bold")) +
  ylab("Temperatura") + xlab("Miesiąc") +
  ggtitle('RozkƂad wartoƛci temperatur względem miesiąca')

ggplot(przejazdy, aes(x = Month, y = Zachmurzenie, fill = Month)) + geom_boxplot(alpha = 0.8) + theme_bw() +
  theme(axis.text.x = element_text(angle = 45, hjust = 1),
        axis.title.x = element_text(color="Grey40", size=16),
        axis.title.y = element_text(color="Grey40", size=16),                            
        legend.position = "none",
        strip.background = element_rect(colour = "black", fill = "white"),
        strip.text = element_text(face = "italic", size = 9),
        plot.title = element_text(color="grey40", size=19, family="serif", face = "bold")) +
  ylab("Zachmurzenie") + xlab("Miesiąc") +
  ggtitle('RozkƂad wartoƛci zachmurzenia względem miesiąca')

ggplot(przejazdy, aes(x = Month, y = Wiatr, fill = Month)) + geom_boxplot(alpha = 0.8) + theme_bw() +
  theme(axis.text.x = element_text(angle = 45, hjust = 1),
        axis.title.x = element_text(color="Grey40", size=16),
        axis.title.y = element_text(color="Grey40", size=16),                            
        legend.position = "none",
        strip.background = element_rect(colour = "black", fill = "white"),
        strip.text = element_text(face = "italic", size = 9),
        plot.title = element_text(color="grey40", size=19, family="serif", face = "bold")) +
  ylab("Wiatr") + xlab("Miesiąc") +
  ggtitle('RozkƂad wartoƛci siƂy wiatru względem miesiąca')

Za pomocą wykresów z pakitu ggridges()

ggplot(przejazdy, aes(x = Temperatura, y = Month, fill = stat(x))) +
  geom_density_ridges_gradient(scale = 3, rel_min_height = 0.01) +
  scale_fill_viridis_c(name = "Temp. [C]", option = "B") +  
  theme_ridges() + labs(title = 'Temperatury w zaleĆŒnoƛci od miesiąca') +
  xlab('Temparatura') + ylab("Miesiąc")

ggplot(przejazdy, aes(x = Ciƛnienie_stacja, y = Month, fill = stat(x))) +
  geom_density_ridges_gradient(scale = 3, rel_min_height = 0.01) +
  scale_fill_viridis_c(name = "Ciƛ. [hPa]", option = "E") +  
  theme_ridges() + labs(title = 'Ciƛnienie powietrza w zaleĆŒnoƛci od miesiąca') + xlab("Ciƛnienie powietrza") +
  ylab("Miesiąc")

ggplot(przejazdy, aes(x = Wilgotnoƛć, y = Month, fill = stat(x))) +
  geom_density_ridges_gradient(scale = 3, rel_min_height = 0.01) +
  scale_fill_viridis_c(name = "Wilg. [%]", option = "D") +  
  theme_ridges() + labs(title = 'Wilgotnoƛć powietrza w zaleĆŒnoƛci od miesiąca') + xlab("Wilgotnoƛć powietrza") +
  ylab("Miesiąc")

Za pomocą kalendarza z pakitu ggcalendR

doKalendarza <- przejazdy[przejazdy$Year == "2019" & przejazdy$Ciƛnienie_stacja > 1022.0, ]
unique(doKalendarza$Data)
##  [1] "2019-01-03" "2019-01-06" "2019-01-07" "2019-02-04" "2019-02-05"
##  [6] "2019-02-06" "2019-02-14" "2019-02-15" "2019-02-16" "2019-02-22"
## [11] "2019-02-23" "2019-02-24" "2019-02-25" "2019-02-26" "2019-03-20"
## [16] "2019-03-21" "2019-03-22" "2019-03-23" "2019-03-27" "2019-03-28"
## [21] "2019-03-29" "2019-04-01" "2019-04-11" "2019-04-12" "2019-04-13"
## [26] "2019-04-14" "2019-04-15" "2019-04-16" "2019-04-17" "2019-04-18"
## [31] "2019-04-19" "2019-04-20" "2019-04-21" "2019-04-22" "2019-05-12"
## [36] "2019-05-13" "2019-05-14" "2019-05-15" "2019-05-30" "2019-06-09"
## [41] "2019-06-23" "2019-06-24" "2019-06-25" "2019-08-21" "2019-08-22"
## [46] "2019-08-23" "2019-08-24" "2019-08-25" "2019-08-26" "2019-09-12"
## [51] "2019-09-13" "2019-09-14" "2019-09-20" "2019-10-30" "2019-10-31"
## [56] "2019-12-27" "2019-12-28" "2019-12-29"
yday(unique(doKalendarza$Data))
##  [1]   3   6   7  35  36  37  45  46  47  53  54  55  56  57  79  80  81  82  86
## [20]  87  88  91 101 102 103 104 105 106 107 108 109 110 111 112 132 133 134 135
## [39] 150 160 174 175 176 233 234 235 236 237 238 255 256 257 263 303 304 361 362
## [58] 363
calendR(year = 2019,
        start = "M",
        special.days = c(3, 6, 7, 35,  36, 37, 45, 46, 47, 53, 54,  
                         55, 56, 57, 79, 80, 81, 82,  
                         86, 87, 88, 91, 101, 102, 103, 104, 105, 106, 107,
                        108, 109, 110, 111, 112, 132, 133, 134, 135, 150, 160, 
                        174, 175, 176, 233, 234, 235, 236, 237, 238, 255, 256, 257, 
                        263, 303, 304, 361, 362, 363),
        special.col = "deepskyblue3",
        low.col = "white",
        weeknames.col = "white",
        weeknames.size = 4,
        lty = 2,
        title = "Dni w 2019 roku z ciƛnieniem powietrza powyĆŒej 1022.0 hPa",
        title.size = 20,
        title.col = 'darkslateblue',
        mbg.col = 'lightgoldenrod3',
        bg.img = 'pressure.jpg',
        font.family = "sans",
        font.style = "plain")